home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / ddsgen.arc / DDSRPF01.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  18.8 KB  |  237 lines
  1.      F********************************************************************      
  2.      F*                                                                  *      
  3.      F*  PGMID -        DDS01RPF01                                       *      
  4.      F*                                                                  *      
  5.      F*  FUNCTION -     GENERATE HEADING BOX AND FILE LEVEL              *      
  6.      F*                 PHYSICAL FILE DDS                                *      
  7.      F*                                                                  *      
  8.      F*  AUTHOR -       TERRENCE W. MOYER                                *      
  9.      F*                 55 KEPPEL AVE.                                   *      
  10.      F*                 WEST LAWN, PA. 19609                             *      
  11.      F*                                                                  *      
  12.      F*  DATE -         NOV. 3, 1986                                     *      
  13.      F*                                                                  *      
  14.      F*  INDICATORS -   10-19  GENERAL PURPOSE, REUSABLE.                *      
  15.      F*                                                                  *      
  16.      F*  NOTES -                                                         *      
  17.      F*                 SUPPORTED KEYWORDS                               *      
  18.      F*                 UNIQUE, LIFO,                                    *      
  19.      F*                 REF (SUPPORTED AT FIELD LEVEL VIA REFFLD KWD)    *      
  20.      F*                                                                  *
  21.      F*                 UNSUPPORTED KEYWORDS                             *      
  22.      F*                 ALTSEQ                                           *      
  23.      F*                                                                  *      
  24.      F********************************************************************      
  25.      FQAFDPHY IF  E                    DISK                           UC        
  26.      FQAFDACCPIF  E                    DISK                           UC        
  27.      FSRCFIL  O   F      92            DISK                      A    UC        
  28.      E                    BOX     1   8 68               HEADING BOX TEXT       
  29.      E                    NOTE    1   1 68               HEADING BOX NOTES      
  30.      E                    WRK        68  1               WORK ARRAY             
  31.      E                    WRK1       36  1               DDS FUNCT. FIELD       
  32.      I*  LDA WITH INPUT FILE AND SOURCE FILE INFORMATION                        
  33.      I           UDS                                                            
  34.      I                                        1  10 LINFL                       
  35.      I                                       11  20 LINLB                       
  36.      I                                       21  22 LINYR                       
  37.      I                                       23  24 LINMO                       
  38.      I                                       25  26 LINDA                       
  39.      I                                       21  26 LINDT                       
  40.      I                                       27  28 LINHH
  41.      I                                       29  30 LINMM                       
  42.      I                                       31  32 LINSS                       
  43.      I                                       27  32 LINTM                       
  44.      I                                       33  33 LINTYP                      
  45.      I                                       51 100 LINTXT                      
  46.      I                                      101 110 LSRCFL                      
  47.      I                                      111 120 LSRCLB                      
  48.      I                                      121 130 LSRCMB                      
  49.      I                                      201 2062LSRCSQ                      
  50.      I                                      207 2120LSRCDT                      
  51.      I* SOURCE SEQUENCE AND SOURCE DATE DS - WRITTEN TO DDS SRCFILE.            
  52.      I            DS                                                            
  53.      I                                        1   62SRCSEQ                      
  54.      I                                        7  120SRCDAT                      
  55.      I* DDS SPECIFICATION - TO WRITE ACTUAL SPEC RECORDS TO DDS SRCFILE.        
  56.      IDSPEC       DS                                                            
  57.      I                                        1   5 DBLNK1                      
  58.      I                                        6   6 DSPECA                      
  59.      I                                        7  16 DBLNK2                      
  60.      I                                       17  17 DNMTYP
  61.      I                                       18  18 DBLNK3                      
  62.      I                                       19  28 DNAME                       
  63.      I                                       29  29 DREF                        
  64.      I                                       30  340DLEN                        
  65.      I                                       35  35 DDTYP                       
  66.      I                                       36  370DDEC                        
  67.      I                                       38  44 DBLNK4                      
  68.      I                                       45  80 DFUNC                       
  69.      I                                        1  80 DSPEC1                      
  70.      I                                        7  80 DSPEC2                      
  71.      I* DDS HEADING BOX - USED TO WRITE HEADING BOX TO DDS SRCFILE.             
  72.      IHEDBOX      DS                                                            
  73.      I                                        1   5 HBLNK1                      
  74.      I                                        6   6 HSPECA                      
  75.      I                                        7   7 HSTAR1                      
  76.      I                                        8   9 HBLNK2                      
  77.      I                                        8  79 HTEXT1                      
  78.      I                                       10  77 HTEXT2                      
  79.      I                                       78  79 HBLNK3                      
  80.      I                                       80  80 HSTAR2
  81.      I                                        1  80 HSPEC1                      
  82.      I*                                                                         
  83.      I            DS                                                            
  84.      I                                        1   60UTIME                       
  85.      I                                        1   2 UHOUR                       
  86.      I                                        3   4 UMIN                        
  87.      I                                        5   6 USEC                        
  88.      I            DS                                                            
  89.      I                                        1   60XDATE                       
  90.      I                                        1   2 XMONTH                      
  91.      I                                        3   4 XDAY                        
  92.      I                                        5   6 XYEAR                       
  93.      C*------------------------------------------------------------------*      
  94.      C*                         MAINLINE                                 *      
  95.      C*------------------------------------------------------------------*      
  96.      C* INITIALIZATION AND SETUP.                                               
  97.     C*                                                                         
  98.      C                     MOVE 'V 1.4'   VERS    5        GET VERSION NBR      
  99.      C                     OPEN QAFDPHY                    OPEN FILES.          
  100.      C                     OPEN QAFDACCP
  101.      C                     OPEN SRCFIL                                          
  102.      C                     READ QAFDACCP                 10 READ FIRST          
  103.      C                     READ QAFDPHY                  10 RECORDS.            
  104.      C                     MOVELPHTXT     LINTXT           MOVE TEXT AND        
  105.      C                     MOVELPHFCTM    LINTM            CREATION TIME.       
  106.      C           UDATE     MULT +10000.01 SRCDAT           INIT SRCDAT          
  107.      C                     Z-ADD*ZERO     SRCSEQ           AND  SRCSEQ.         
  108.      C                     MOVE 'A'       DSPECA           INITIALIZE           
  109.      C                     MOVE 'A'       HSPECA           DATA STRUCTURE       
  110.      C                     MOVE '*'       HSTAR1           FIELDS.              
  111.      C                     MOVE '*'       HSTAR2                                
  112.      C                     MOVE *ALL'*'   HTEXT1                                
  113.      C* MAKE HEADING BOX.                                                       
  114.      C*                                                                         
  115.      C                     MOVEABOX,1     WRK              MOVE GENERATOR       
  116.     C                     MOVEAVERS      WRK,36           VERSION TO BOX.      
  117.      C                     MOVEAWRK       BOX,1                                 
  118.      C                     MOVEABOX,2     WRK              MOVE FILE NAME       
  119.      C                     MOVEALINFL     WRK,21           TO HEADING BOX.      
  120.      C                     MOVEAWRK       BOX,2
  121.      C                     MOVEABOX,3     WRK                                   
  122.      C                     MOVEALINLB     WRK,21           FILE LIBRARY         
  123.      C                     MOVEAWRK       BOX,3                                 
  124.      C                     MOVEABOX,5     WRK                                   
  125.      C                     MOVEALINMO     WRK,21           CREATION DATE        
  126.      C                     MOVEALINDA     WRK,24                                
  127.      C                     MOVEALINYR     WRK,27                                
  128.      C                     MOVEALINHH     WRK,43           CREATION TIME        
  129.      C                     MOVEALINMM     WRK,46                                
  130.      C                     MOVEALINSS     WRK,49                                
  131.      C                     MOVEAWRK       BOX,5                                 
  132.      C                     TIME           UTIME                                 
  133.      C                     Z-ADDUDATE     XDATE                                 
  134.      C                     MOVEABOX,6     WRK                                   
  135.      C                     MOVEAXMONTH    WRK,21           DDS DATE             
  136.      C                     MOVEAXDAY      WRK,24                                
  137.      C                     MOVEAXYEAR     WRK,27                                
  138.      C                     MOVEAUHOUR     WRK,43           DDS TIME             
  139.      C                     MOVEAUMIN      WRK,46                                
  140.      C                     MOVEAUSEC      WRK,49
  141.      C                     MOVEAWRK       BOX,6                                 
  142.      C                     MOVEABOX,7     WRK                                   
  143.      C                     MOVEALINTXT    WRK,15           FILE TEXT            
  144.      C                     MOVEAWRK       BOX,7                                 
  145.      C*                                                                         
  146.      C* WRITE HEADING BOX TO SOURCE FILE.                                       
  147.      C                     MOVE HSPEC1    LINE   80        WRITE TOP            
  148.      C                     EXSR @SRCLN                     BORDER OF BOX.       
  149.      C                     MOVE *BLANK    HTEXT1                                
  150.      C           +1        DO   +7        X       30       WRITE BOX            
  151.      C                     MOVEABOX,X     HTEXT2           TEXT INFO.           
  152.      C                     MOVE HSPEC1    LINE   80                             
  153.      C                     EXSR @SRCLN                                          
  154.      C                     MOVE *BLANK    HTEXT2                                
  155.      C                     MOVE HSPEC1    LINE                                  
  156.      C                     EXSR @SRCLN                                          
  157.      C                     END                              END DO              
  158.      C*                                                                         
  159.      C           PHCSEQ    IFEQ 'Y'                         CHECK IF NOTES      
  160.      C                     ADD  +1        SRCSEQ            NEED TO WRITE.
  161.      C                     MOVE HSPEC1    LINE                                  
  162.      C                     MOVEABOX,8     HTEXT2            (NOTES IDENT.       
  163.      C                     EXCPTSRCLIN                       UNSUPPORTED        
  164.      C                     ADD  +1        SRCSEQ             KEYWORDS ON        
  165.      C                     MOVEANOTE,1    HTEXT2             HEADING BOX)       
  166.      C                     MOVE HSPEC1    LINE                                  
  167.      C                     EXCPTSRCLIN                                          
  168.      C                     MOVE *BLANK    HTEXT2            WRITE A             
  169.      C                     MOVE HSPEC1    LINE              COMMENT             
  170.      C                     EXSR @SRCLN                      SEPARATOR           
  171.      C                     END                              AFTER NOTES.        
  172.      C*                                                                         
  173.      C                     MOVE *ALL'*'   HTEXT1            WRITE BOTTOM        
  174.      C                     MOVE HSPEC1    LINE              BORDER.             
  175.      C                     EXSR @SRCLN                                          
  176.      C                     MOVE *BLANK    HTEXT1            WRITE A             
  177.      C                     MOVE HSPEC1    LINE              COMMENT             
  178.      C                     EXSR @SRCLN                      SEPARATOR.          
  179.      C*------------------------------------------------------------------*      
  180.      C*                     WRITE FILE LEVEL KEYWORDS.
  181.     C*------------------------------------------------------------------*      
  182.     C*                                                                         
  183.      C*  WRITE  UNIQUE AND LIFO KEYWORDS IF APPLICABLE.                         
  184.     C*                                                                         
  185.     C           APUNIQ    IFEQ 'Y'                                             
  186.      C                     MOVEL'UNIQUE'  DFUNC                                 
  187.      C                     MOVE DSPEC1    LINE                                  
  188.      C                     EXSR @SRCLN                                          
  189.      C                     MOVE *BLANK    DSPEC2                                
  190.      C                     END                                                  
  191.      C*                                                                         
  192.      C           APKEYO    IFEQ 'L'                                             
  193.      C                     MOVEL'LIFO'    DFUNC                                 
  194.      C                     MOVE DSPEC1    LINE                                  
  195.      C                     EXSR @SRCLN                                          
  196.      C                     MOVE *BLANK    DSPEC2                                
  197.      C                     END                                                  
  198.      C*                                                                         
  199.      C* CLOSE FILES AND END PROGRAM.                                            
  200.      C*
  201.      C                     CLOSEQAFDPHY                                         
  202.      C                     CLOSEQAFDACCP                                        
  203.      C                     CLOSESRCFIL                                          
  204.      C*                                                                         
  205.      C                     Z-ADDSRCSEQ    LSRCSQ           PASS SRCSEQ          
  206.      C                     Z-ADDSRCDAT    LSRCDT           AND SRCDAT           
  207.      C                     SETON                       LR                       
  208.      C*                                                                         
  209.      C*------------------------------------------------------------------*      
  210.      C*       ADD TO SOURCE SEQUENCE NUMBER AND WRITE AN OUTPUT LINE            
  211.      C*------------------------------------------------------------------*      
  212.      C*                                                                         
  213.      C           @SRCLN    BEGSR                                                
  214.      C*                                                                         
  215.      C                     ADD  +1        SRCSEQ                                
  216.      C                     EXCPTSRCLIN                                          
  217.      C*                                                                         
  218.      C                     ENDSR                                                
  219.      C*------------------------------------------------------------------*      
  220.      C/SPACE 3
  221.      OSRCFIL  EADD             SRCLIN                                           
  222.      O                         SRCSEQ     6                                     
  223.      O                         SRCDAT    12                                     
  224.      O                         LINE      92                                     
  225. **   HEADING BOX TEXT ARRAY                                                     
  226.                        *  DDSGEN         *                                     
  227. FILE NAME:                                                                      
  228. FILE LIBRARY:                                                                   
  229. FILE TYPE:          PHYSICAL                                                    
  230. FILE CREATION DATE: 00/00/00       TIME:  HH.MM.SS                              
  231. DDS  CREATION DATE: 00/00/00       TIME:  HH.MM.SS                              
  232. FILE TEXT:    15-65                                                             
  233. NOTES:                                                                          
  234. **                                                                              
  235. ALTSEQ - This file level keyword is not supported.
  236. 
  237.